home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
program
/
swagn_r.zip
/
NUMBERS.SWG
/
0054_Permutinf Words.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-08-25
|
2KB
|
90 lines
{
Here is another attempt. It will also work with any length string
and generates all permutations without running out of memory, by
searching in a depth-first fashion.
}
{$M 64000,0,655360}
program perms2;
uses Crt;
type str52 = string[52];
const objects : str52 = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
var m, n,
fw, level,
nperline : integer;
p1, p2 : str52;
nperms : longint;
procedure p (var p1, p2 : str52; var level : integer);
var p1n, p2n : str52;
i, nlevel : integer;
begin
if level < m
then
begin
nlevel := level + 1;
for i := 1 to length(p2) do
begin
p1n := p1 + p2[i];
p2n := p2;
delete (p2n, i, 1);
p (p1n, p2n, nlevel);
end;
end
else
begin
write (p1:fw);
inc (nperms);
end;
end;
begin
repeat
clrscr;
repeat
write ('How many objects altogether? ');
readln (n);
until (n>=0) and (n<53);
if n>0
then
begin
repeat
write ('How many in each permutation? ');
readln (m);
until (m>0) and (m<=n);
writeln;
case m of
1 : fw := 2; { 40 per line }
2..3 : fw := 4; { 20 per line }
4 : fw := 5; { 16 per line }
5..7 : fw := 8; { 10 per line }
8..9 : fw := 10; { 8 per line }
10..15 : fw := 16; { 5 per line }
16..19 : fw := 20; { 4 per line }
20..39 : fw := 40; { 2 per line }
40..52 : fw := 80; { 1 per line }
end;
nperline := 80 div fw;
level := 0;
p1 := '';
p2 := copy (objects, 1, n);
nperms := 0;
p (p1, p2, level);
if (nperms mod nperline) <> 0 then writeln;
writeln;
writeln (nperms,' Permutations generated.');
readln;
end;
until n=0;
end.
{
This one is a little more elegant, and should also be a little
easier to decipher than the last one! Hope this will be of some
use to you!
}